package TS::ARIBString;

use strict;
use Encode qw(from_to);
use Binary;
use TS::ARIBString::Gaiji;

use constant JIS_KANJI_IN => pack('H*', '1B2442');
use constant JIS_KANJI_OUT => pack('H*', '1B2842');

use constant GSET_KANJI => 0x42;
use constant GSET_ASCII => 0x4A;
use constant GSET_HIRAGANA => 0x30;
use constant GSET_KATAKANA => 0x31;
use constant GSET_MOSAIC_A => 0x32;
use constant GSET_MOSAIC_B => 0x33;
use constant GSET_MOSAIC_C => 0x34;
use constant GSET_MOSAIC_D => 0x35;
use constant GSET_PRO_ASCII => 0x36;
use constant GSET_PRO_HIRAGANA => 0x37;
use constant GSET_PRO_KATAKANA => 0x38;
use constant GSET_JIS_X0201_KATAKANA => 0x49;
use constant GSET_JIS_KANJI1 => 0x39;
use constant GSET_JIS_KANJI2 => 0x3A;
use constant GSET_GAIJI => 0x3B;

use constant GSET_BYTES => {
	0x42 => 2,
	0x4A => 1,
	0x30 => 1,
	0x31 => 1,
	0x32 => 1,
	0x33 => 1,
	0x34 => 1,
	0x35 => 1,
	0x36 => 1,
	0x37 => 1,
	0x38 => 1,
	0x49 => 1,
	0x39 => 2,
	0x3A => 2,
	0x3B => 2,
};

use constant PRO_ASCII => [
	0x2121, 0x212a, 0x2149, 0x2174, 0x2170, 0x2173, 0x2175, 0x2147,
	0x214a, 0x214b, 0x2176, 0x215c, 0x2124, 0x215d, 0x2125, 0x213f,
	0x2330, 0x2331, 0x2332, 0x2333, 0x2334, 0x2335, 0x2336, 0x2337,
	0x2338, 0x2339, 0x2127, 0x2128, 0x2163, 0x2161, 0x2164, 0x2129,
	0x2177, 0x2341, 0x2342, 0x2343, 0x2344, 0x2345, 0x2346, 0x2347,
	0x2348, 0x2349, 0x234a, 0x234b, 0x234c, 0x234d, 0x234e, 0x234f,
	0x2350, 0x2351, 0x2352, 0x2353, 0x2354, 0x2355, 0x2356, 0x2357,
	0x2358, 0x2359, 0x235a, 0x214e, 0x216f, 0x214f, 0x2130, 0x2132,
	0x212e, 0x2361, 0x2362, 0x2363, 0x2364, 0x2365, 0x2366, 0x2367,
	0x2368, 0x2369, 0x236a, 0x236b, 0x236c, 0x236d, 0x236e, 0x236f,
	0x2370, 0x2371, 0x2372, 0x2373, 0x2374, 0x2375, 0x2376, 0x2377,
	0x2378, 0x2379, 0x237a, 0x2150, 0x2143, 0x2151, 0x2131, 
];

use constant HIRAGANA_EX => [0x2135, 0x2136, 0x213C, 0x2123, 0x2156, 0x2157, 0x2122, 0x2126];
use constant KATAKANA_EX => [0x2133, 0x2134, 0x213C, 0x2123, 0x2156, 0x2157, 0x2122, 0x2126];

sub new {
	my($pkg, $buf) = @_;

	my $hash = {
		buffer => undef,
		put => undef,
		jis => undef,
		kanji => 0,
	};

	my $s = bless $hash, $pkg;

	$s->{buffer} = Binary->new($buf);
	$s->{put} = Binary->new();
	$s->parse();

	return $s;
}

sub sjis {
	my($buf) = @_;

	my $out = &utf8($buf);
	from_to($out, 'utf8', 'cp932');
	return $out;
}

sub utf8 {
	my($buf) = @_;

	my $s = TS::ARIBString->new($buf);
	return $s->{put}->{buf};
}

sub parse {
	my($s) = @_;

	my @g = ();
	$g[0] = GSET_JIS_KANJI1;
	$g[1] = GSET_PRO_ASCII;
	$g[2] = GSET_HIRAGANA;
	$g[3] = GSET_KATAKANA;

	my $gl = 0;
	my $gr = 2;
	my $ss = 0;

	while($s->{buffer}->{pos} < $s->{buffer}->{length}) {
		my $c = $s->{buffer}->getInt();

		if ($c == 0x0F) {
			# LS0
			$gl = 0;
		} elsif ($c == 0x0E) {
			# LS1
			$gl = 1;
		} elsif ($c == 0x1B) {
			# ESC
			my $d = $s->{buffer}->getInt();

			if ($d == 0x6E) {
				# LS2
				$gl = 2;
			} elsif ($d == 0x6F) {
				# LS3
				$gl = 3;
			} elsif ($d == 0x7E) {
				# LS1R
				$gr = 1;
			} elsif ($d == 0x7D) {
				# LS2R
				$gr = 2;
			} elsif ($d == 0x7C) {
				# LS3R
				$gr = 3;
			} elsif ($d == 0x24) {
				# 2 bytes
				my $e = $s->{buffer}->getInt();

				if ($e == 0x29) {
					# G1
					$g[1] = $s->{buffer}->getInt();
				} elsif ($e == 0x2A) {
					# G2
					$g[2] = $s->{buffer}->getInt();
				} elsif ($e == 0x2B) {
					# G3
					$g[3] = $s->{buffer}->getInt();
				} else {
					# G0
					$g[0] = $e;
				}
			} elsif ($d == 0x28) {
				# G0
				$g[0] = $s->{buffer}->getInt();
			} elsif ($d == 0x29) {
				# G1
				$g[1] = $s->{buffer}->getInt();
			} elsif ($d == 0x2A) {
				# G2
				$g[2] = $s->{buffer}->getInt();
			} elsif ($d == 0x2B) {
				# G3
				$g[3] = $s->{buffer}->getInt();
			} else {
				# other
				printf "#### no support esc 0x%02x\n", $d;
#				exit;
			}
		} elsif ($c == 0x19) {
			# SS2
			$ss = 2;
		} elsif ($c == 0x1D) {
			# SS3
			$ss = 3;
		} else {
			# other

			if ($c < 0x20) {
				# C0
			} elsif (0x20 == $c) {
				# SP
				$s->gmap(GSET_PRO_ASCII, $c);
			} elsif (0x20 < $c && $c < 0x7F) {
				# GL
				my $gt = $gl;

				if ($ss) {
					$gt = $ss;
					$ss = 0;
				}

				my $gset = $g[$gt];
				my $byte = GSET_BYTES->{$gset};

				if ($byte == 2) {
					my $d = $s->{buffer}->getInt();
					$c = $c << 8 | $d;
				}

#				printf "GL gset 0x%02x byte %d char 0x%04x\n", $gset, $byte, $c;
				$s->gmap($gset, $c);
			} elsif (0x7F == $c) {
				# DEL
			} elsif (0x7F < $c && $c < 0xA0) {
				# C1
			} elsif (0xA0 <= $c) {
				# GR
				my $gset = $g[$gr];
				my $byte = GSET_BYTES->{$gset};

				if ($byte == 2) {
					my $d = $s->{buffer}->getInt();
					$c = $c << 8 | $d;
				}

				$c &= 0x7F7F;

#				printf "GR gset 0x%02x byte %d char 0x%04x\n", $gset, $byte, $c;
				$s->gmap($gset, $c);
			}
		}
	}

	$s->endKanji();
}

sub gmap {
	my($s, $gset, $c) = @_;

	if ($gset == GSET_JIS_KANJI1) {
		$s->setKanji($c);
	} elsif ($gset == GSET_ASCII) {
		$s->setAscii($c);
	} elsif ($gset == GSET_PRO_ASCII) {
		$s->setKanji(PRO_ASCII->[$c - 0x20]);
	} elsif ($gset == GSET_HIRAGANA || $gset == GSET_PRO_HIRAGANA) {
		if ($c < 0x77) {
			$s->setKanji($c + 0x2400);
		} else {
			$s->setKanji(HIRAGANA_EX->[$c - 0x77]);
		}
	} elsif ($gset == GSET_KATAKANA || $gset == GSET_PRO_KATAKANA) {
		if ($c < 0x77) {
			$s->setKanji($c + 0x2500);
		} else {
			$s->setKanji(KATAKANA_EX->[$c - 0x77]);
		}
	} elsif ($gset == GSET_GAIJI) {
		my $ku = ($c >> 8) - 0x20;
		my $ten = ($c & 0xFF) - 0x21;
#		print "ku $ku ten $ten\n";
		my $gaiji = TS::ARIBString::Gaiji::GAIJI->{$ku}->[$ten];

		if ($gaiji eq '') {
			$s->setString(sprintf("[%04x]", $c));
#			exit;
		} else {
			$s->setString($gaiji);
		}
	} else {
		printf "#### no support map 0x%02x\n", $gset;
#		exit;
	}
}

sub setKanji {
	my($s, $c) = @_;

	if (!$s->{kanji}) {
		$s->{jis} = Binary->new();
		$s->{jis}->setBytes(JIS_KANJI_IN);
		$s->{kanji} = 1;
	}

	$s->{jis}->setShort($c);
}

sub endKanji {
	my($s) = @_;

	if ($s->{kanji}) {
		$s->{jis}->setBytes(JIS_KANJI_OUT);
		from_to($s->{jis}->{buf}, 'jis', 'utf8');
		$s->{jis}->{buf} =~ s/\xE3\x80\x9C/\xEF\xBD\x9E/g;
		$s->{put}->setBytes($s->{jis}->{buf});
		$s->{kanji} = 0;
	}
}

sub setAscii {
	my($s, $c) = @_;

	$s->endKanji();
	$s->{put}->setInt($c);
}

sub setString {
	my($s, $c) = @_;

	$s->endKanji();
	$s->{put}->setBytes($c);
}

1;
